home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue33 / random / TstRndU2.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1998-03-18  |  2.4 KB  |  104 lines
  1. {*********************************************************}
  2. {* TstRndU2                                              *}
  3. {* Copyright (c) Julian M Bucknall 1998                  *}
  4. {* All rights reserved.                                  *}
  5. {*********************************************************}
  6. {* Random number test program - generators               *}
  7. {*********************************************************}
  8.  
  9. {Note: this unit is released as freeware. In other words, you are free
  10.        to use this unit in your own applications, however I retain all
  11.        copyright to the code. JMB}
  12.  
  13. {$X+}
  14.  
  15. unit TstRndU2;
  16.  
  17. interface
  18.  
  19. type
  20.   TRandomGenerator = function : double;
  21.     {-type of a random number generator for our tests}
  22.  
  23. var
  24.   AlgorithmKSeed : longint;  {Seed for Algorithm K}
  25.  
  26. function SystemRandom : double;
  27.   {-the system random routine}
  28. function AlgorithmK : double;
  29.   {-algorithm K: a flawed linear congruential generator}
  30. function AdditiveGenerator : double;
  31.   {-an additive generator}
  32.  
  33. procedure InitializeAdditiveGenerator;
  34. procedure DestroyAdditiveGenerator;
  35.  
  36. implementation
  37.  
  38. const
  39.   RandArraySize = 55;
  40.  
  41. type
  42.   PRandArray = ^TRandArray;
  43.   TRandArray = array [0..pred(RandArraySize)] of longint;
  44.  
  45. const
  46.   Inx1   : integer = 0;
  47.   Inx2   : integer = 0;
  48.   RArray : PRandArray = nil;
  49.  
  50. function SystemRandom : double;
  51. begin
  52.   Result := Random;
  53. end;
  54.  
  55. function AlgorithmK : double;
  56. begin
  57.   if (AlgorithmKSeed = 0) then
  58.     AlgorithmKSeed := 1;
  59.   AlgorithmKSeed := (AlgorithmKSeed * 31415927) mod 27182819;
  60.   Result := abs(AlgorithmKSeed) / 27182819.0;
  61. end;
  62.  
  63. function AdditiveGenerator : double;
  64. begin
  65.   if (RArray = nil) then begin
  66.     Result := 0.0;
  67.     Exit;
  68.   end;
  69.   RArray^[Inx1] := RArray^[Inx1] + RArray^[Inx2];
  70.   Result := (RArray^[Inx1] shr 1) / 2147483648.0;
  71.   inc(Inx1);
  72.   if (Inx1 = 55) then
  73.     Inx1 := 0;
  74.   inc(Inx2);
  75.   if (Inx2 = 55) then
  76.     Inx2 := 0;
  77. end;
  78.  
  79. procedure InitializeAdditiveGenerator;
  80. var
  81.   i : integer;
  82.   R : double;
  83. begin
  84.   if (RArray = nil) then begin
  85.     New(RArray);
  86.     for i := 0 to pred(RandArraySize) do begin
  87.       R := Random; {throw away the result-we just need the 32-bit value}
  88.       RArray^[i] := RandSeed;
  89.     end;
  90.     Inx1 := 0;
  91.     Inx2 := 33;
  92.   end;
  93. end;
  94.  
  95. procedure DestroyAdditiveGenerator;
  96. begin
  97.   if (RArray <> nil) then begin
  98.     Dispose(RArray);
  99.     RArray := nil;
  100.   end;
  101. end;
  102.  
  103. end.
  104.